home *** CD-ROM | disk | FTP | other *** search
/ BBS in a Box 7 / BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso / Files / Prog / H-K / Inside Mac DA 2.4.cpt / IM Source / IM.Pas next >
Pascal/Delphi Source File  |  1987-08-09  |  14KB  |  606 lines
  1. program Inside_Macintosh;
  2.  
  3. {    Version 2.0,  12.11.1986
  4.     Version 2.1,  26.11.1986    Bug in PageDown, PageUp beseitigt
  5.     Version 2.2,  15.12.1986    Bug Groß/Kleinschreibung beseitigt
  6.     Version 2.3,  16.01.1987   Bug Zahl/Buchstabe beseitigt
  7.     Version 2.4,  06.08.1987   Deklarationen Mac ][ und Copy/Paste hinzugefügt
  8.     Version 2.41, 09.08.1987   Backspace implementiert
  9.     
  10.     Autor: Arne Schirmacher, Gutenbergstraße 14, D-6070 Langen
  11.     
  12.     Der Quellcode zum Inside-Macintosh-Deskaccessory ist   n i c h t 
  13.     Public Domain. Alle Usergroups, Vereine ect. werden gebeten, nur
  14.     das compilierte Programm weiterzugeben. 
  15. }
  16.  
  17. uses
  18.     MacIntf;
  19.     
  20. {$U Search}
  21. {$A+}
  22.  
  23. const
  24.     accEvent                = 64;
  25.     accRun                = 65;
  26.     accCursor            = 66;
  27.     accMenu                = 67;
  28.     accUndo                = 68;
  29.     accCut                = 70;
  30.     accCopy                = 71;
  31.     accPaste                = 72;
  32.     accClear                = 73;
  33.  
  34.     proc                    = 'PROCEDURE ';
  35.     func                    = 'FUNCTION ';
  36.     cons                    = 'CONST ';
  37.     StrListType            = 'STR#';
  38.  
  39. type  DAGlobals = record
  40.     i                                : Integer;
  41.     maxLines                        : Integer;
  42.     ID0,ID1,ID2,ID3,ID4        : Integer;
  43.     theDialog                    : DialogPtr;
  44.     StrList0                        : Handle;
  45.     StrList1                        : Handle;
  46.     StrList2                        : Handle;
  47.     StrList3                        : Handle;
  48.     StrList4                        : Handle;
  49.     ScrollBar                    : ControlHandle;
  50.     SearchBox                    : Rect;
  51.     FoundBox                        : Rect;
  52.     CommentBox                    : Rect;
  53.     SearchFrame                    : Rect;
  54.     FoundFrame                    : Rect;
  55.     CommentFrame                : Rect;
  56.     searchStr                    : Str255;
  57.     foundStr                        : Str255;
  58.     commentStr                    : Str255;
  59.  end;
  60.  
  61.     DAGlobalsP                    = ^DAGlobals;
  62.     DAGlobalsH                    = ^DAGlobalsP;
  63.  
  64.  
  65. procedure Search(searchStr: Ptr; list: Ptr; var i: Integer);
  66.  
  67. external;
  68.  
  69.  
  70.  
  71. procedure GetProc;
  72.  
  73. var
  74.     theString            : Str255;
  75.     DAVarsH                : DAGlobalsH;
  76.     
  77. begin
  78.  
  79. { lokale Variablen wiederfinden }
  80.  
  81.     DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  82.     with DAVarsH^^ do begin
  83.  
  84. { Teilstring 'PROCEDURE', 'FUNCTION' oder 'CONST' machen }
  85.  
  86.         LoadResource(StrList0);
  87.         GetIndString(theString,ID0,i);
  88.         HPurge(StrList0);
  89.         if theString[1] = 'P' then foundStr := proc;
  90.         if theString[1] = 'F' then foundStr := func;
  91.         if theString[1] = 'C' then foundStr := cons;
  92.  
  93. { Kommentarstring machen, Index ist Byte in theString[2] }
  94.  
  95.         commentStr := '';
  96.         if ord(theString[2]) >0 then begin
  97.             LoadResource(StrList4);
  98.             GetIndString(commentStr,ID4,ord(theString[2]));
  99.             HPurge(StrList4);
  100.         end; { if }
  101.  
  102. { Prozedurnamen an foundStr anhängen }
  103.  
  104.         LoadResource(StrList1);
  105.         GetIndString(theString,ID1,i);
  106.         HPurge(StrList1);
  107.         foundStr := concat(foundStr,theString);
  108.         foundStr := concat(foundStr,' ');
  109.  
  110. { Deklaration (2 Hälften) an foundStr anhängen }
  111.  
  112.         LoadResource(StrList2);
  113.         GetIndString(theString,ID2,i);
  114.         HPurge(StrList2);
  115.         foundStr := concat(foundStr,theString);
  116.         LoadResource(StrList3);
  117.         GetIndString(theString,ID3,i);
  118.         HPurge(StrList3);
  119.         foundStr := concat(foundStr,theString);
  120.  
  121.     end; { with }
  122. end;
  123.  
  124.  
  125.  
  126. procedure ScrollUp(theControl: ControlHandle; partCode: Integer);
  127.  
  128. var
  129.     ticks                : LongInt;
  130.     DAVarsH            : DAGlobalsH;
  131.     
  132. begin
  133.  
  134. { lokale Variablen wiederfinden }
  135.  
  136.     DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  137.     with DAVarsH^^ do begin
  138.  
  139. { 1 Eintrag weitergehen }
  140.  
  141.         Delay(5,ticks);
  142.         i := GetCtlValue(ScrollBar);
  143.         if i < maxLines then begin
  144.             i := i + 1;
  145.             SetCtlValue(ScrollBar,i);
  146.             GetProc;
  147.             TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  148.             TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  149.         end; { if }
  150.     end; { with }
  151. end;
  152.  
  153.  
  154.  
  155. procedure ScrollDown(theControl: ControlHandle; partCode: Integer);
  156.  
  157. var
  158.     ticks                : LongInt;
  159.     DAVarsH            : DAGlobalsH;
  160.     
  161. begin
  162.  
  163. { lokale Variablen wiederfinden }
  164.  
  165.     DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  166.     with DAVarsH^^ do begin
  167.  
  168. { 1 Eintrag zurückgehen }
  169.  
  170.         Delay(5,ticks);
  171.         i := GetCtlValue(ScrollBar);
  172.         if i > 1 then begin
  173.             i := i - 1;
  174.             SetCtlValue(ScrollBar,i);
  175.             GetProc;
  176.             TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  177.             TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  178.         end; { if }
  179.     end; { with }
  180. end;
  181.  
  182.  
  183.  
  184. procedure PageUp(theControl: ControlHandle; partCode: Integer);
  185.  
  186. var
  187.     DAVarsH            : DAGlobalsH;
  188.     
  189. begin
  190.     if partCode = inPageDown then begin
  191.  
  192. { lokale Variablen wiederfinden }
  193.  
  194.         DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  195.         with DAVarsH^^ do begin
  196.  
  197. { 25 Einträge weitergehen }
  198.  
  199.             i := GetCtlValue(ScrollBar);
  200.             if i <> maxLines then begin
  201.                 i := i + 25;
  202.                 if i > maxLines then i := maxLines;
  203.                 SetCtlValue(ScrollBar,i);
  204.                 GetProc;
  205.                 TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  206.                 TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  207.             end; { if i <> }
  208.         end; { with }
  209.     end; { if partCode }
  210. end;
  211.  
  212.  
  213.  
  214. procedure PageDown(theControl: ControlHandle; partCode: Integer);
  215.  
  216. var
  217.     DAVarsH            : DAGlobalsH;
  218.     
  219. begin
  220.     if partCode = inPageUp then begin
  221.  
  222. { lokale Variablen wiederfinden }
  223.  
  224.         DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  225.         with DAVarsH^^ do begin
  226.  
  227. { 25 Einträge zurückgehen }
  228.  
  229.             i := GetCtlValue(ScrollBar);
  230.             if i <> 1 then begin
  231.                 i := i - 25;
  232.                 if i < 1 then i := 1;
  233.                 SetCtlValue(ScrollBar,i);
  234.                 GetProc;
  235.                 TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  236.                 TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  237.             end; { if i <> }
  238.         end; { with }
  239.     end; { if partCode }
  240. end;
  241.  
  242.  
  243.  
  244. procedure HandleMouse(theEvent: EventRecord);
  245.  
  246. var
  247.     result            : Integer;
  248.     itemhit            : Integer;
  249.     ticks                : LongInt;
  250.     myDialog            : DialogPtr;
  251.     whichControl    : ControlHandle;
  252.     DAVarsH            : DAGlobalsH;
  253.     Pic                : PicHandle;
  254.     where                : Point;
  255.     theRect            : Rect;
  256.     myEvent            : EventRecord;
  257.     theString        : Str255;
  258.     
  259. begin
  260.  
  261. { lokale Variablen wiederfinden }
  262.  
  263.     DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  264.     with DAVarsH^^ do begin
  265.  
  266. { betrifft Mausklick das Desk Accessory ? }
  267.  
  268.         if DialogSelect(theEvent,myDialog,itemHit) then
  269.  
  270. { in Info-Knopf geklickt ? }
  271.  
  272.             if itemHit = 5 then begin
  273.                 Pic := GetPicture(ID0);
  274.                 theRect.top := 10;
  275.                 theRect.left := 10;
  276.                 with Pic^^.picFrame do begin
  277.                     theRect.bottom := bottom - top + 10;
  278.                     theRect.right := 10 + right - left;
  279.                 end;
  280.                 EraseRect(theDialog^.portRect);
  281.                 DrawPicture(Pic,theRect);
  282.                 theRect := theDialog^.portRect;
  283.                 SetRect(theRect,theRect.right - 90,theRect.bottom - 30,
  284.                                     theRect.right - 10,theRect.bottom - 10);
  285.                 whichControl := NewControl(theDialog,theRect,'OK',true,0,0,0,pushButProc,0);
  286.                 repeat until GetOSEvent(mDownMask,myEvent);
  287.                 HiliteControl(whichControl,10);
  288.                 Delay(5,ticks);
  289.                 HiliteControl(whichControl,0);
  290.                 Delay(5,ticks);
  291.                 EraseRect(theDialog^.portRect);
  292.                 InvalRect(theDialog^.portRect);
  293.                 ReleaseResource(Handle(Pic));
  294.                 DisposeControl(whichControl);
  295.             end; { if itemHit = 5 }
  296.  
  297. { in Rollbalken geklickt ? }
  298.  
  299.             if itemHit = 4 then begin
  300.                 searchStr := '';
  301.                 EraseRect(searchBox);
  302.                 where := theEvent.where;
  303.                 GlobalToLocal(where);
  304.                 case TestControl(ScrollBar,where) of
  305.                     inUpButton        : result := TrackControl(ScrollBar,where,@ScrollDown);
  306.                     inDownButton    : result := TrackControl(ScrollBar,where,@ScrollUp);
  307.                     inPageUp            : result := TrackControl(ScrollBar,where,@PageDown);
  308.                     inPageDown        : result := TrackControl(ScrollBar,where,@PageUp);
  309.                     inThumb            : begin
  310.                                             result := TrackControl(ScrollBar,where,nil);
  311.                                             i := GetCtlValue(ScrollBar);
  312.                                             GetProc;
  313.                                                 TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  314.                                                 TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  315.                                           end;
  316.                 end; { case }
  317.             end; { if itemHit = 4 }
  318.     end; { with }
  319. end; { HandleMouse }
  320.  
  321.  
  322.  
  323. procedure HandleKey(theEvent: EventRecord);
  324.  
  325. var
  326.     c                    : char;
  327.     iOld                : Integer;
  328.     j                    : Integer;
  329.     err                : LongInt;
  330.     scrapResult        : LongInt;
  331.     DAVarsH            : DAGlobalsH;
  332.     theString        : Str255;
  333.     
  334. begin
  335.  
  336. { Lokale Variablen wiederfinden }
  337.  
  338.     DAVarsH := pointer(WindowPeek(FrontWindow)^.refCon);
  339.     with DAVarsH^^ do begin
  340.  
  341.         c := chr(BitAnd(theEvent.message,charCodeMask));
  342.  
  343.         if (c in ['x','X','c','C']) and (BitAnd(theEvent.modifiers,cmdKey) <> 0) then begin
  344.             scrapResult := ZeroScrap;
  345.             scrapResult := PutScrap(length(foundStr),'TEXT',@foundStr[1]);
  346.         end { if (c in ['x','X','c','C'])... }
  347.  
  348.         else begin
  349.         
  350. { ist Zeichen Buchstabe oder Zahl ? }
  351.     
  352.             if c in ['A'..'Z'] then
  353.                 c := chr(ord(c) + 32);
  354.             if not ((c in ['a'..'z']) or (c in ['0'..'9'])) then
  355.                 if c = chr(8) then begin
  356.                     i := 0;
  357.                     iOld := -1;
  358.                     theString := searchStr;
  359.                     searchStr := '';
  360.                     LoadResource(StrList1);
  361.                     HNoPurge(StrList1);
  362.                     for j := 1 to length(theString) - 1 do begin
  363.                         searchStr[0] := chr(j);
  364.                         searchStr[j] := theString[j];
  365.                         Search(@searchStr,StrList1^,i);
  366.                     end; { for j := 1 }
  367.                     TextBox(@searchStr[1],length(searchStr),SearchBox,teJustLeft);
  368.                 end
  369.                 else
  370.                     i := 0
  371.  
  372.             else begin
  373.     
  374. { Zeichen in Searchbox anfügen und ausdrucken }
  375.     
  376.                 searchStr := concat(searchStr,c);
  377.                 TextBox(@searchStr[1],length(searchStr),SearchBox,teJustLeft);
  378.     
  379. { in Prozedurnamen suchen }
  380.     
  381.                 iOld := i;
  382.                 LoadResource(StrList1);
  383.                 HNoPurge(StrList1);
  384.                 Search(@searchStr,StrList1^,i);
  385.                 SetCtlValue(ScrollBar,i);
  386.             end; { else }
  387.             if i = 0 then begin
  388.     
  389.     { nichts gefunden, alle Felder löschen }
  390.     
  391.                 searchStr := '';
  392.                 foundStr := '';
  393.                 commentStr := '';
  394.                 EraseRect(SearchBox);
  395.                 EraseRect(FoundBox);
  396.                 EraseRect(CommentBox);
  397.             end
  398.             else begin
  399.     
  400.     { wenn ein neuer Eintrag gefunden wurde, Felder aktualisieren }
  401.     
  402.                 if i <> iOld then begin
  403.                     GetProc;
  404.                     TextBox(@searchStr[1],length(searchStr),SearchBox,teJustLeft);
  405.                     TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  406.                     TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  407.                 end; { if i <> iOld }
  408.             end; { else }
  409.         end;
  410.     end; { with }
  411. end; { HandleKey }
  412.  
  413.  
  414.  
  415.  
  416. procedure Open(var Device: DCtlEntry; var Block: ParamBlockRec);
  417.  
  418. var
  419.         typ            : Integer;
  420.         oldPort        : GrafPtr;
  421.         WPeek            : WindowPeek;
  422.         m                : ^Integer;
  423.         TmpPtr        : Ptr;
  424.         item            : Handle;
  425.         DAVarsH        : DAGlobalsH;
  426.         workRect        : Rect;
  427.         theString    : Str255;
  428.         
  429. begin
  430.     with Device do begin
  431.         if DCtlWindow = nil then begin
  432.  
  433. { Platz für Variablen des Desk Accessory bereitstellen }
  434.  
  435.             TmpPtr := NewPtr($1000);        
  436.             DCtlStorage := NewHandle(sizeof(DAGlobals));
  437.             HLock(DCtlStorage);
  438.             DisposPtr(TmpPtr);
  439.             DAVarsH := DAGlobalsH(DCtlStorage);
  440.             with DAVarsH^^ do begin
  441.  
  442. { benötigte Resource ID Nummern berechnen }
  443.  
  444.                 ID0 := $BFE0 - 32 * DCtlRefNum;
  445.                 ID1 := ID0 + 1;
  446.                 ID2 := ID0 + 2;
  447.                 ID3 := ID0 + 3;
  448.                 ID4 := ID0 + 4;
  449.  
  450. { Dialogfenster des DAs initialisieren }
  451.                 
  452.                 theDialog := GetNewDialog(ID0,nil,pointer(-1));
  453.                 DCtlWindow := pointer(theDialog);
  454.                 WPeek := WindowPeek(theDialog);
  455.                 WPeek^.windowKind := DCtlRefNum;
  456.                 WPeek^.refCon := ord4(DAVarsH);
  457.                 GetPort(oldPort);
  458.                 SetPort(theDialog);
  459.  
  460. { Rechtecke initialisieren }
  461.  
  462.                 GetDItem(theDialog,1,typ,item,SearchFrame);
  463.                 SearchBox := SearchFrame;
  464.                 InsetRect(SearchFrame,-3,-3);
  465.                 GetDItem(theDialog,2,typ,item,FoundFrame);
  466.                 FoundBox := FoundFrame;
  467.                 InsetRect(FoundFrame,-3,-3);
  468.                 GetDItem(theDialog,3,typ,item,CommentFrame);
  469.                 CommentBox := CommentFrame;
  470.                 InsetRect(CommentFrame,-3,-3);
  471.  
  472. { Daten einladen }
  473.  
  474.                 StrList0 := GetResource(StrListType,ID0);
  475.                 StrList1 := GetResource(StrListType,ID1);
  476.                 StrList2 := GetResource(StrListType,ID2);
  477.                 StrList3 := GetResource(StrListType,ID3);
  478.                 StrList4 := GetResource(StrListType,ID4);
  479.                 i := 0;
  480.                 m := pointer(StrList0^);
  481.                 maxLines := m^;
  482.                 foundStr := 'Inside Macintosh Version 2.41';
  483.                 searchStr := '';
  484.                 commentStr := '';
  485.  
  486. { Rollbalken }
  487.  
  488.                 GetDItem(theDialog,4,typ,item,workRect);
  489.                 ScrollBar := NewControl(theDialog,workRect,'',true,
  490.                                                 1,1,maxLines,scrollBarProc,0);
  491.                 
  492.             end; { with }
  493.  
  494. { Aufräumarbeiten }
  495.  
  496.             HUnlock(DCtlStorage);
  497.             SetPort(oldPort);
  498.         end; { if }
  499.     end; { with }
  500. end; { Open }
  501.  
  502.  
  503.  
  504. procedure Ctl(var Device: DCtlEntry; var Block: ParamBlockRec);
  505.  
  506. var
  507.     Trick: Record
  508.         case integer of
  509.                     0: (CSParam: array[0..1] of Integer);
  510.                     1: (EventPtr: ^EventRecord)
  511.         end;
  512.         
  513.     savedKind        : Integer;
  514.     scrapResult        : LongInt;
  515.     oldPort            : GrafPtr;
  516.     WPeek                : WindowPeek;
  517.     DAVarsH            : DAGlobalsH;
  518.         
  519. begin
  520.     with Device do begin
  521.         HLock(DCtlStorage);
  522.         DAVarsH := DAGlobalsH(DCtlStorage);
  523.         with DAVarsH^^ do begin
  524.             GetPort(oldPort);
  525.             SetPort(theDialog);
  526.             WPeek := WindowPeek(theDialog);
  527.             savedKind := WPeek^.windowKind;
  528.             WPeek^.windowKind := dialogKind;
  529.             case Block.csCode of
  530.                 accCut, accCopy: begin
  531.                     scrapResult := ZeroScrap;
  532.                     scrapResult := PutScrap(length(foundStr),'TEXT',@foundStr[1]);
  533.                 end; { accCut }
  534.                 accEvent:  begin
  535.                     Trick.CSParam[0] := Block.CSParam[0];
  536.                     Trick.CSParam[1] := Block.CSParam[1];
  537.                     case Trick.EventPtr^.what of
  538.                         mouseDown:    HandleMouse(Trick.EventPtr^);
  539.                         keyDown:      HandleKey(Trick.EventPtr^);
  540.                         updateEvt:    begin
  541.  
  542.                                             { alles zeichnen }
  543.  
  544.                                             beginUpdate(theDialog);
  545.                                             DrawDialog(theDialog);
  546.                                             DrawControls(theDialog);
  547.                                             TextBox(@searchStr[1],length(searchStr),SearchBox,teJustLeft);
  548.                                             FrameRect(SearchFrame);
  549.                                             TextBox(@foundStr[1],length(foundStr),FoundBox,teJustLeft);
  550.                                             FrameRect(FoundFrame);
  551.                                             TextBox(@commentStr[1],length(commentStr),CommentBox,teJustLeft);
  552.                                             FrameRect(CommentFrame);
  553.                                             FrameRect(ScrollBar^^.contrlRect);
  554.                                             endUpdate(theDialog);
  555.                                         end; { updateEvt }
  556.  
  557.                         activateEvt: begin
  558.                                             if odd(Trick.EventPtr^.modifiers) then  { Rollbalken aktivieren }
  559.                                                 ShowControl(ScrollBar)
  560.                                             else begin                                {Rollbalken deaktivieren }
  561.                                                 HideControl(ScrollBar);
  562.                                                 FrameRect(ScrollBar^^.contrlRect);
  563.                                             end; { else }
  564.                                           end; { activateEvt }
  565.                     end; { case }
  566.                 end; { accEvent }
  567.             end; { case }
  568.             WPeek^.windowKind := savedKind;
  569.             HUnLock(DCtlStorage);
  570.             SetPort(oldPort);
  571.         end; { with }
  572.     end; { with }
  573. end; { of Ctl }
  574.  
  575.  
  576.  
  577. procedure Close(var Device: DCtlEntry; var Block: ParamBlockRec);
  578.  
  579. var
  580.     DAVarsH                : DAGlobalsH;
  581.     
  582. begin
  583.     with Device do begin
  584.         HLock(DCtlStorage);
  585.         DAVarsH := DAGlobalsH(DCtlStorage);
  586.         with DAVarsH^^ do begin
  587.  
  588. { Application Heap aufräumen }
  589.  
  590.             DisposDialog(theDialog);
  591.             ReleaseResource(StrList0);
  592.             ReleaseResource(StrList1);
  593.             ReleaseResource(StrList2);
  594.             ReleaseResource(StrList3);
  595.             ReleaseResource(StrList4);
  596.             DisposHandle(Handle(DCtlStorage));
  597.             DCtlStorage := nil;
  598.             DCtlWindow := nil;
  599.         end; { with }
  600.     end; { with }
  601. end; { Close }
  602.  
  603.  
  604. begin
  605. end.
  606.